{ -------------------------------------------------------------------------------------}
{ A "CheckListBox" component for Delphi32.                                             }
{ Copyright 1997, Patrick Brisacier.  All Rights Reserved.                             }
{ This component can be freely used and distributed in commercial and private          }
{ environments, provided this notice is not modified in any way.                       }
{ -------------------------------------------------------------------------------------}
{ Feel free to contact us if you have any questions, comments or suggestions at        }
{ PBrisacier@mail.dotcom.fr (Patrick Brisacier)                                        }
{ -------------------------------------------------------------------------------------}
{ Date last modified:  07/05/96                                                        }
{ -------------------------------------------------------------------------------------}

{ -------------------------------------------------------------------------------------}
{ TPBCheckListBox v1.06                                                                }
{ -------------------------------------------------------------------------------------}
{ Description:                                                                         }
{   A component that adds check property to ListBoxes items.                           }
{ Added Properties to ListBox:                                                         }
{   property Checked[Index: Integer]: Boolean;          "Run-time only property"       }
{   property State[Index: Integer]: TCheckBoxState;     "Run-time only property"       }
{   property AllowGrayed: Boolean;                                                     }
{   property Flat: Boolean;                                                            }
{   property FixedSize: Boolean;                                                       }
{   property Offset: Integer;                                                          }
{   property BmpChecked: TBitmap;                                                      }
{   property BmpGrayed: TBitmap;                                                       }
{   property BmpUnchecked: TBitmap;                                                    }
{                                                                                      }
{ See example contained in example.zip file for more details.                          }
{ -------------------------------------------------------------------------------------}
{ Revision History:                                                                    }
{ 1.00:  + Initial release                                                             }
{ 1.01:  + Modified by Davide Moretti <dmoretti@iper.net>                              }
{        + Changed the drawing method to use a scaleable checkmark image               }
{        + Added the 'Flat' property to select the checkmark type (3D or flat)         }
{        + Added a keyboard handle to select items with <SPACE>                        }
{        + Correctly frees item objects when component is destroyed                    }
{ 1.02:  + Modified by Patrick Brisacier (Thanks to Davide)                            }
{        + Add the 'FixedSize' property to select the checkbox size (Fix or scaleable) }
{        + Add three bitmap properties for custom checkbox                             }
{ 1.03:  + Modified by Davide Moretti <dmoretti@iper.net>                              }
{        + Now if FixedSize is True, the minimum item height is 15 even if the font    }
{	   is smaller                                                                  }
{ 1.04:  + Modified by Patrick Brisacier                                               }
{        + if we use bitmap the minimum item height is the height of the bitmap +2     }
{          pixels. (I suppose that all the bitmaps have the same height)               }
{ 1.05:  + Modified by Patrick Brisacier (thanks to Enrico Lodolo)                     }
{        + avoid flickering by adding a new method 'InvalidateCheck' which redraw only }
{          one checkbox.                                                               }
{ 1.06:  + Modified to work with Delphi 3 (TCheckListBox renamed in TPBCheckListBox to }
{          avoid a conflict with the same named component provided with Delphi 3)      }
{ -------------------------------------------------------------------------------------}

unit PBCheckLB;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls;

type
	TItemState = class
	public
		Checked: Boolean;
		State: TCheckBoxState;
	end;

	TPBCheckListBox = class(TCustomListBox)
	private
		{ Private declarations }
		{ for the state of every element }
		FAllowGrayed: Boolean;
		FFlat: Boolean;
		FFixedSize: Boolean;
		{ Offset between the listbox border and the bitmap }
		{ and between the bitmap and the text              }
		FOffset: Integer;
		{ Bitmaps for the checkbox }
		FBmpChecked: TBitmap;
		FBmpGrayed: TBitmap;
		FBmpUnchecked: TBitmap;
		{ Mantain a list of created objects so they can be freed when component
			is destroyed }
		FStateList: TList;

		{ Create an object associated with an item if it doesn't exist }
		procedure CreateObject(Index: Integer);
		{ Redraw the listbox if the font change }
		procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    { Avoid flickering by redrawing only the change item }
    procedure InvalidateCheck(Index:Integer);
	protected
		{ Set and Get functions for the properties }
		procedure SetChecked(Index: Integer; const AChecked: Boolean);
		function GetChecked(Index: Integer): Boolean;
		procedure SetState(Index: Integer; const AState: TCheckBoxState);
		function GetState(Index: Integer): TCheckBoxState;
		procedure SetOffset(AnOffset: Integer);
		procedure SetFlat(Value: Boolean);
		procedure SetFixedSize(Value: Boolean);
    procedure SetBmpChecked(Value: TBitmap);
    procedure SetBmpGrayed(Value: TBitmap);
    procedure SetBmpUnchecked(Value: TBitmap);

    { Draw each item }
		procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    { Handle <SPACE KEY> }
		procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    { Test if the mouse click hit the checkboxes }
		procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
	public
		{ constructor and destructor }
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		{ new properties for the checkbox management }
		property Checked[Index: Integer]: Boolean
						 read GetChecked write SetChecked;
		property State[Index: Integer]: TCheckBoxState
						 read GetState write SetState;
	published
		{ new properties for the checkbox management }
		property AllowGrayed: Boolean
						 read FAllowGrayed write FAllowGrayed
             default False;
		property Flat: Boolean
             read FFlat write SetFlat
             default False;
		property Offset: Integer
						 read FOffset write SetOffset
						 default 4;
    property FixedSize: Boolean
             read FFixedSize write SetFixedSize
             default True;
    property BmpChecked: TBitmap
             read FBmpChecked write SetBmpChecked;
    property BmpGrayed: TBitmap
             read FBmpGrayed write SetBmpGrayed;
    property BmpUnchecked: TBitmap
             read FBmpUnchecked write SetBmpUnchecked;

		{ pusblish the TListBox properties }
		property Align;
		property BorderStyle;
		property Color;
		property Columns;
		property Ctl3D;
		property DragCursor;
		property DragMode;
		property Enabled;
		property ExtendedSelect;
		property Font;
		property IntegralHeight;
		property ItemHeight;
		property Items;
		property MultiSelect;
		property ParentColor;
		property ParentCtl3D;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ShowHint;
		property Sorted;
		property Style default lbOwnerDrawFixed;
		property TabOrder;
		property TabWidth;
		property Visible;

		{ pusblish the TListBox events }
		property OnClick;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnDrawItem;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnMeasureItem;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnStartDrag;

	end;

procedure Register;

implementation

constructor TPBCheckListBox.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
  { create the bitmaps }
  FBmpChecked := TBitmap.Create;
  FBmpGrayed := TBitmap.Create;
  FBmpUnchecked := TBitmap.Create;
	{ create the state-object list }
	FStateList := TList.Create;
	{ initialize the default values }
  FFixedSize := True;
	FOffset := 4;
	Style := lbOwnerDrawFixed;
end;

destructor TPBCheckListBox.Destroy;
var
  i: Integer;
begin
  for i := 0 to FStateList.Count - 1 do
    TItemState(FStateList[i]).Free;
  FStateList.Free;
  { free the bitmaps }
  FBmpChecked.Free;
  FBmpGrayed.Free;
  FBmpUnchecked.Free;
  inherited Destroy;
end;

procedure TPBCheckListBox.CreateObject(Index: Integer);
var
	MyItemState: TItemState;
begin
	{ check the range of Index }
	if (Index < 0) or (Index >= Items.Count) then Exit;
	if Items.Objects[Index] = nil then begin
		MyItemState := TItemState.Create;
		Items.Objects[Index] := MyItemState;
		FStateList.Add(MyItemState);
	end;
end;

procedure TPBCheckListBox.SetChecked(Index: Integer; const AChecked: Boolean);
begin
	{ check the range of Index }
	if (Index < 0) or (Index >= Items.Count) then Exit;
	CreateObject(Index);
	if TItemState(Items.Objects[Index]).Checked <> AChecked then begin
		TItemState(Items.Objects[Index]).Checked := AChecked;
		if AChecked then
			TItemState(Items.Objects[Index]).State := cbChecked
		else
			TItemState(Items.Objects[Index]).State := cbUnchecked;
		InvalidateCheck(Index);
	end;
end;

function TPBCheckListBox.GetChecked(Index: Integer): Boolean;
begin
	{ check the range of Index }
	if (Index < 0) or (Index >= Items.Count) then
  begin
		Result := False;
		Exit;
  end;
	CreateObject(Index);
	Result := TItemState(Items.Objects[Index]).Checked;
end;

procedure TPBCheckListBox.SetState(Index: Integer; const AState: TCheckBoxState);
begin
	{ check the range of Index }
	if (Index < 0) or (Index >= Items.Count) then Exit;
	CreateObject(Index);
	if TItemState(Items.Objects[Index]).State <> AState then begin
		TItemState(Items.Objects[Index]).State := AState;
		case AState of
		cbChecked:
			TItemState(Items.Objects[Index]).Checked := True;
		cbGrayed:
			TItemState(Items.Objects[Index]).Checked := False;
		cbUnchecked:
			TItemState(Items.Objects[Index]).Checked := False;
		end;
		InvalidateCheck(Index);
	end;
end;

function TPBCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
	{ check the range of Index }
	if (Index < 0) or (Index >= Items.Count) then
  begin
		Result := cbUnchecked;
		Exit;
  end;
	CreateObject(Index);
	Result := TItemState(Items.Objects[Index]).State;
end;

procedure TPBCheckListBox.SetFlat(Value: Boolean);
begin
	if Value <> FFlat then begin
		FFlat := Value;
		Invalidate;
	end;
end;

procedure TPBCheckListBox.SetOffset(AnOffset: Integer);
begin
	if FOffset <> AnOffset then begin
		FOffset := AnOffset;
		Invalidate;
	end;
end;

procedure TPBCheckListBox.SetFixedSize(Value: Boolean);
begin
	if Value <> FFixedSize then begin
		FFixedSize := Value;
		{ Set item height }
		ItemHeight := Canvas.TextHeight(' ');
    if (FBmpChecked.Empty) or (FBmpGrayed.Empty) or (FBmpUnchecked.Empty) then begin
    { if we don't use bitmap }
      if FFixedSize and (ItemHeight < 15) then
      { If FixedSize is True then height must be >= 15 }
        ItemHeight := 15;
    end
    else begin
    { if we use bitmaps, the min height must be the height of the bitmap +2 pixels }
      if (ItemHeight < FBmpChecked.Height + 2) then
        ItemHeight := FBmpChecked.Height + 2;
    end;
		Invalidate;
	end;
end;

procedure TPBCheckListBox.SetBmpChecked(Value: TBitmap);
begin
  FBmpChecked.Assign(Value);
  Invalidate;
end;

procedure TPBCheckListBox.SetBmpGrayed(Value: TBitmap);
begin
  FBmpGrayed.Assign(Value);
  Invalidate;
end;

procedure TPBCheckListBox.SetBmpUnchecked(Value: TBitmap);
begin
  FBmpUnchecked.Assign(Value);
  Invalidate;
end;

procedure TPBCheckListBox.InvalidateCheck(Index:Integer);
var
  IRect: TRect;
begin
  IRect := ItemRect(Index);
  Inc(IRect.Left, FOffset);
  IRect.Right := IRect.Left + ItemHeight;
  InvalidateRect(Handle, @IRect, False);
end;



{ Changed to use 3D drawing }
procedure TPBCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  TheBitmap: TBitmap;
	X, Y: Integer;
	r1: TRect;
	st: Integer;
begin
	if Assigned(OnDrawItem) then
		OnDrawItem(Self, Index, Rect, State)
	else begin
    if (FBmpChecked.Empty) or (FBmpGrayed.Empty) or (FBmpUnchecked.Empty) then
    begin
    { if we have not all the three bitmaps we use the API }
      { calculate the right shape to use }
      case Self.State[Index] of
			cbChecked:
        st := DFCS_BUTTONCHECK or DFCS_CHECKED;
      cbUnchecked:
        st := DFCS_BUTTONCHECK;
      else // csGrayed: so Delphi won't give a warning :-)
        st := DFCS_BUTTON3STATE or DFCS_CHECKED {or DFCS_INACTIVE};
      end;
			if FFlat then
        st := st or DFCS_FLAT;
      { draw the item }
      with Canvas do begin
        FillRect(Rect);
        if FFixedSize then begin { checkbox with fixed size }
          r1.Left := Rect.Left + FOffset;
          r1.Top := Rect.Top + (Rect.Bottom - Rect.Top - 13) div 2;
          r1.Bottom := r1.Top + 13;
					r1.Right := r1.Left + 13;
        end
        else begin { checkbox with variable size }
          r1.Left := Rect.Left + FOffset;
          r1.Top := Rect.Top + 1;
          r1.Bottom := Rect.Bottom - 1;
          r1.Right := r1.Bottom - r1.Top + r1.Left;
				end;
        DrawFrameControl(Handle, r1, DFC_BUTTON, st);
        { draw the text of the item }
        X := r1.Right + FOffset;
        Y := Rect.Top + (Rect.Bottom - Rect.Top - TextHeight(' ')) div 2;
        Rect.Left := X;
        TextRect(Rect, X, Y, Items[Index]);
      end
    end { end of drawing with the API }
		else begin
    { if we have all the three bitmaps we use them }
      { calculate the right bitmap to use }
      case Self.State[Index] of
      cbChecked:
        TheBitmap := FBmpChecked;
      cbGrayed:
	TheBitmap := FBmpGrayed;
      cbUnchecked:
        TheBitmap := FBmpUnchecked;
      else
        TheBitmap := FBmpUnchecked;
      end;
      { draw the item }
      with Canvas do begin
        FillRect(Rect);
        X := Rect.Left + FOffset;
        Y := Rect.Top + (Rect.Bottom - Rect.Top - TheBitmap.Height) div 2;
				Draw(X, Y, TheBitmap);
        X := X + TheBitmap.Width + FOffset;
        Y := Rect.Top + (Rect.Bottom - Rect.Top - TextHeight(' ')) div 2;
        Rect.Left := X;
        TextRect(Rect, X, Y, Items[Index]);
      end;
    end;
	end;
end;

procedure TPBCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
	Index: Integer;
	Rect: TRect;
begin
	Index := ItemAtPos(Point(X, Y), True);
	if Index <> -1 then begin
		Rect := ItemRect(Index);
		if (Button = mbLeft)
				and (X >= Rect.Left + FOffset)
				and (X < Rect.Left + FOffset + (Rect.Bottom - Rect.Top - 2)) then
		begin
			case State[Index] of
			cbUnchecked:
				if FAllowGrayed then
					State[Index] := cbGrayed
				else
					State[Index] := cbChecked;
			cbChecked:
				State[Index] := cbUnchecked;
			cbGrayed:
				State[Index] := cbChecked;
			end;
			InvalidateCheck(Index);
		end;
	end;
	inherited;
end;

procedure TPBCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
	if ItemIndex <> -1 then begin
		if Key = VK_SPACE then
			case State[ItemIndex] of
			cbUnchecked:
				if FAllowGrayed then
					State[ItemIndex] := cbGrayed
				else
					State[ItemIndex] := cbChecked;
			cbChecked:
				State[ItemIndex] := cbUnchecked;
			cbGrayed:
				State[ItemIndex] := cbChecked;
			end;
			InvalidateCheck(ItemIndex);
		end;
	inherited;
end;

procedure TPBCheckListBox.CMFontChanged(var Message: TMessage);
begin
	inherited;
	Canvas.Font := Font;
	ItemHeight := Canvas.TextHeight(' ');
  if (FBmpChecked.Empty) or (FBmpGrayed.Empty) or (FBmpUnchecked.Empty) then begin
  { if we don't use bitmap }
    if FFixedSize and (ItemHeight < 15) then
    { If FixedSize is True then height must be >= 15 }
      ItemHeight := 15;
  end
  else begin
  { if we use bitmaps, the min height must be the height of the bitmap +2 pixels }
    if (ItemHeight < FBmpChecked.Height + 2) then
      ItemHeight := FBmpChecked.Height + 2;
  end;
end;

procedure Register;
begin
	RegisterComponents('Win32', [TPBCheckListBox]);
end;

end.
